R-Ladies + Lingwars: Taller de minería de textos con R

R-Ladies Madrid, Verónica García y Claudia Guirao, 17/10/2017

¿Quiénes somos?

• Verónica García, @yryaa
• Claudia Guirao, @claudiaguirao

RLadies y Data Scientists en Kernel Analytics

Código y datos en https://github.com/intiveda/rladies_textmining

Text Mining & NLP

Gran parte de los datos se encuentran no estructurados, es importante conocer técnicas que nos permitan obtener conclusiones a partir de los mensajes que generan nuestras organizaciones, clientes o usuarios.

Hoy aprenderemos algunas técnicas básicas para manipular cadenas de texto y aplicaremos técnicas de NLP a subtítulos para obtener algunas conclusiones.

Materiales y librerías

• Subtítulos temporadas de los Simpsons
• Librerías:
• stringr
• subtools
• tm
• tidytext
• tidyverse
• dplyr
• datatable
• ggplot2
• plotly(opcional)
• igraph
• ggraph
• worldcloud
• knitr
• wordcloud

Puedes seguir este tutorial de dos formas:

1. Escuchando activamente, para probar luego en casa :)
2. De forma activa, ejecutando en tu equipo:

• Descarga el notebook del repositorio.
• Abre el archivo .Rmd en R Studio (para poder ejecutar notebooks necesitarás algunas dependencias)
• Fija el working directory dentro de la carpeta rladies_textmining: setwd("eldirectoriodondehasdescargadoelrepo/rladies_textmining/")
• Chequea que tienes las librerías instaladas.

c(
  "stringr",
  "subtools",
  "tm",
  "tidytext",
  "tidyverse",
  "dplyr",
  "data.table",
  "ggplot2",
  "plotly",
  "igraph",
  "ggraph",
  "wordcloud",
  "knitr"
  ) %in% rownames(installed.packages())

 [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE

---

Back2basics: Strings y expresiones regulares

Las cadenas o strings cumplen un papel importante en las tareas de ETL o preparación de los datos. Una de las librerías esenciales en la materia es stringr

Stringr es uno de los paquetes diseñados por Hadley Wickham para asistir en las tareas de manipulación de strings:

• se integra con pipes (%<%)
• sus funciones son consistentes y fáciles de interpretar

¿Qué son las cadenas de texto o strings?

• Las cadenas de texto se encuentran contenidas entre comillas "" (*usar la comilla simple ' para escapar la doble comilla)
• Pueden contener letras "a", números "1", símbolos "&" o todo lo anterior "1a&"
• Mientras que los números puede ser a la vez integers y characters, las letras y los símbolos no tienen significado como integer y se traducen en NA

as.integer(c("a", "&", "123"))

[1]  NA  NA 123

c(factor("a"), "b", "&",1)

[1] "1" "b" "&" "1"

Concatenar integers y characters, convierte automáticamente los integers en characters.

c(as.character(factor("a")), "b", "&",1)

[1] "a" "b" "&" "1"

Operaciones básicas

Importar la librería

# install.packages("stringr")
library(stringr)

Operadores

Muchas de estas funciones tiene su equivalente en R base, pueden ser más lentas/menos eficientes.

• str_to_upper(string): convierte un string en mayúsculas
• str_to_lower(string): convierte un string en minúsculas
• str_to_title(string): capitaliza un string

temas <- c("Código", "Mujeres", "tecnología", "Informática", "estadística", "Women", "Coders", "Aprendizaje", "automático", "Análisis", "datos", "Visualización", "R-Ladies", "Social", "Coding", "R", "Ciencia", "Programming")

str_to_upper(temas)

 [1] "CÓDIGO"        "MUJERES"       "TECNOLOGÍA"    "INFORMÁTICA"   "ESTADÍSTICA"   "WOMEN"        
 [7] "CODERS"        "APRENDIZAJE"   "AUTOMÁTICO"    "ANÁLISIS"      "DATOS"         "VISUALIZACIÓN"
[13] "R-LADIES"      "SOCIAL"        "CODING"        "R"             "CIENCIA"       "PROGRAMMING"  

str_to_lower(temas)

 [1] "código"        "mujeres"       "tecnología"    "informática"   "estadística"   "women"        
 [7] "coders"        "aprendizaje"   "automático"    "análisis"      "datos"         "visualización"
[13] "r-ladies"      "social"        "coding"        "r"             "ciencia"       "programming"  

str_to_title(temas)

 [1] "Código"        "Mujeres"       "Tecnología"    "Informática"   "Estadística"   "Women"        
 [7] "Coders"        "Aprendizaje"   "Automático"    "Análisis"      "Datos"         "Visualización"
[13] "R-Ladies"      "Social"        "Coding"        "R"             "Ciencia"       "Programming"  

• str_c(string, sep = ""): junta varios string en uno solo, es el equivalente a paste(sep = "") o paste0()
• str_length(string): devuelve la longitud del string, es similar a la función nchar(). Convierte los factores en strings y conserva los NA’s

print(str_length('R-Ladies'))

[1] 8

print(str_length(NA))

[1] NA

• str_sub(string, start, end): subsetea un string o un vector de string especificando la posición inicial y la final, es el equivalente en R base a substr(). Por defecto finaliza en el último caracter.

print(temas[1:4])

[1] "Código"      "Mujeres"     "tecnología"  "Informática"

str_sub(string = temas[1:4], start=3)

[1] "digo"      "jeres"     "cnología"  "formática"

• str_dup(string, times): copia y pega un string un número determinado de veces

str_dup(string = temas[1:4], times = 3)

[1] "CódigoCódigoCódigo"                "MujeresMujeresMujeres"            
[3] "tecnologíatecnologíatecnología"    "InformáticaInformáticaInformática"

• str_trim(string, side = c("both", "left", "rigth")): elimina los espacios vacíos, por defecto toma el valor both. Mejor evitar gsub(" ", "", string)
• str_pad(string, width, side = c("left", "both", "right"), pad = " ")): añade a strings espacios en blanco para igualarlos en longitud, especialmente útil para añadir 0 a números.

Expresiones regulares

Las expresiones regulares ( regular expressions, regex, pattern matching) son un lenguaje usado para parsear y manipular texto. Se usan comúnmente para hacer operaciones de búsqueda y reemplazo y para validar si un texto está bien formado.

Expresiones comunes

• “a” = letra “a”
• “^a” = empieza con la letra “a”
• “a$” = finaliza con la letra “a”
• “” = contiene cualquier letra (o número) de las contenidas en los corchetes
• “[ - ]” = contiene cualquier letra (o número) dentro de un rango
• “[^ae]” = cualquier cosa excepto determinadas letras (o números)
• “{3}” = repite la expresión regular 3 veces

Las expresiones regulares son un mundo en si mismo, aquí tienes una pequeña chuleta : https://www.rstudio.com/wp-content/uploads/2016/09/RegExCheatsheet.pdf

rcosas = c("baseR", "R-Ladies", "Rmeetup", "Rmarkdown", "stringR")
str_detect(rcosas, pattern = "^R")

[1] FALSE  TRUE  TRUE  TRUE FALSE

rcosas[str_detect(rcosas, pattern = "^R")]

[1] "R-Ladies"  "Rmeetup"   "Rmarkdown"

rcosas[str_detect(rcosas, pattern = "R")]

[1] "baseR"     "R-Ladies"  "Rmeetup"   "Rmarkdown" "stringR"  

cleanR <- c("tidyverse", "tidyr","dplyr", "ggplot2", "tidytext", "purrr")
str_locate(cleanR, "tidy")

     start end
[1,]     1   4
[2,]     1   4
[3,]    NA  NA
[4,]    NA  NA
[5,]     1   4
[6,]    NA  NA

Otras funciones

• str_extract(string, pattern) o str_extract_all(): busca la palabra exacta (normalmente se utiliza con expresiones regulares concatenadas)
• str_match(string, pattern) o str_match_all(): es una función equivalente pero devuelve una matriz

str_match(c("12345678", "12587465", "dni desconocido"), pattern = "[1-9]{8}")

     [,1]      
[1,] "12345678"
[2,] "12587465"
[3,] NA        

str_match_all(c("12345678", "12587465", "dni desconocido"), pattern = "[1-9]{8}")

[[1]]
     [,1]      
[1,] "12345678"

[[2]]
     [,1]      
[1,] "12587465"

[[3]]
     [,1]

• str_replace(string, pattern, replacement): reemplaza la primera instancia, str_replace_all para reemplazarlas todas

str_replace(c("castanya", "otonyo", "veronyo", "anyo", "nyonyo"), pattern = "ny", replacement = "ñ")

[1] "castaña" "otoño"   "veroño"  "año"     "ñonyo"  

str_replace_all(c("castanya", "otonyo", "veronyo", "anyo", "nyonyo"), pattern = "ny", replacement = "ñ")

[1] "castaña" "otoño"   "veroño"  "año"     "ñoño"   

• str_split(string, pattern): separa una cadena en un vector, str_split_fixed(string, pattern, n) lo hace en un número n determinado de elementos

print(str_split("Eres muy chu chu chuli",pattern = " "))

[[1]]
[1] "Eres"  "muy"   "chu"   "chu"   "chuli"

print(length(str_split("Eres muy chu chu chuli",pattern = " ")[[1]]))

[1] 5

Analizando texto con R: los Simpsons fuente de sabiduría

Leer los subtitutos

La librería subtools permite leer archivos .str y .sub, así como organizar cada diálogo en un data frame.
Los archivos han de estar organizados en directorios por temporadas y cada uno ha de estar nombrado como S01xE01 para que se parsee correctamente el número de temporada y de episodio.

Nos centraremos en las 9 primeras temporadas de los Simpsons. Si descargamos la puntuación y representamos gráficamente el promedio del score por temporada, se observa un claro descenso a partir de la 10. Por otro lado son las temporadas que mejor conocemos gracias a sus numerosas repeticiones :)

knitr::include_graphics("./images/ratings.png",dpi = 100)

A continuación leemos los subtítulos ( en inglés ) de las 9 primeras temporadas de los Simpsons.

#devtools::install_github("fkeck/subtools")
library(subtools)
a <- read.subtitles.serie(dir = "./The Simpsons/")

Read: 9 seasons, 203 episodes

df <- subDataFrame(a)
df <- df[complete.cases(df), ]
str(df)

'data.frame':   57672 obs. of  8 variables:
 $ ID          : chr  "<U+FEFF>1""| __truncated__ "2" "3" "4" ...
 $ Timecode.in : chr  "00:00:00.042" "00:00:08.759" "00:00:10.761" "00:00:15.557" ...
 $ Timecode.out: chr  "00:00:00.042" "00:00:10.677" "00:00:13.180" "00:00:17.851" ...
 $ Text        : chr  "23.976" "Ooh! Careful, Homer!" "There's no time. We're late." "O little town of Bethlehem" ...
 $ season      : chr  "season 1" "season 1" "season 1" "season 1" ...
 $ season_num  : num  1 1 1 1 1 1 1 1 1 1 ...
 $ episode_num : num  1 1 1 1 1 1 1 1 1 1 ...
 $ serie       : chr  "The Simpsons" "The Simpsons" "The Simpsons" "The Simpsons" ...

Primer análisis: tm

Una primera opción es emplear la librería tm para nuestro análisis. La función tm_map nos va a permitir preparar nuestor documento para el análisis:

• conformar un corpus (conjunto estructurado de textos / documentos )
• transformar en minúsculas nuestro texto
• eliminar los signos de puntuación
• eliminar los números
• eliminar las stopwords
• eliminar los espacios en blanco

library(tm)

Loading required package: NLP

c <- tmCorpus(a)
c <- tm_map(c, content_transformer(tolower))
c <- tm_map(c, removePunctuation)
c <- tm_map(c, removeNumbers)
c <- tm_map(c, removeWords, stopwords("english"))
c <- tm_map(c, stripWhitespace)
c

<<SimpleCorpus>>
Metadata:  corpus specific: 1, document level (indexed): 4
Content:  documents: 203

El segundo paso, una vez preparado nuestro corpus, será el de construir la matriz de términos documentos. Para simplificar el análisis cada temporada constituirá un documento. De esta forma obtenemos para cada término la frecuencia por temporada.

TDM <- TermDocumentMatrix(c)
TDM <- as.matrix(TDM)
vec.season <- c(rep(x = 1,13), rep(2, 22), rep(3,24), rep(4,22), rep(5,22), rep(6,25), rep(7,25),rep(8,25), rep(9,25)) #episodios por temp
TDM.season <- t(apply(TDM, 1, function(x) tapply(x, vec.season, sum)))
colnames(TDM.season) <- paste0("S_", unique(vec.season))
head(TDM.season)

           
Terms       S_1 S_2 S_3 S_4 S_5 S_6 S_7 S_8 S_9
  able        6   4   3   0   6   7   4   2   4
  aboard      1   1   2   2   2   2   2   1   1
  acts        1   1   1   0   0   1   0   0   1
  adult       1   3   2   0   3   3   1   1   1
  affecting   1   0   0   0   0   0   0   0   0
  afford      5   8   5   1   2   4   8   6   1

A continuación representamos en una nube de términos dichas frecuencias: el tamaño indica el número de repeticiones y el color la temporada en la que más repeticiones presenta. La posición del término respecto de la etiqueta de temporada indica también la frecuencia por temporada.

library(wordcloud)

Loading required package: RColorBrewer

set.seed(100)
comparison.cloud(TDM.season, title.size = 1, max.words = 200, random.order = T)

Text mining con tidytext

La librería tidytext nos permite realizar operaciones como tf (frecuencia de términos) o tf_idf (frecuencia de término - frecuencia inversa de documento) con mayor agilidad.

Preparar el corpus

De nuevo vamos a preparar el nuestros diálogos para el análisis eliminado las stopwords.

library(tidytext)

package <U+393C><U+3E31>tidytext<U+393C><U+3E32> was built under R version 3.3.3

library(tidyverse)

package <U+393C><U+3E31>tidyverse<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>ggplot2<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>tibble<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>tidyr<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>readr<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>purrr<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>dplyr<U+393C><U+3E32> was built under R version 3.3.3

data(stop_words)
tidy_df <- df %>%
  unnest_tokens(word, Text) %>%
  dplyr::anti_join(stop_words)

Eliminamos además aquellas “palabras” constituidas exclusivamente por números y la palabra simpson.

library(data.table)

data.table 1.10.4
  The fastest way to learn (by data.table authors): https://www.datacamp.com/courses/data-analysis-the-data-table-way
  Documentation: ?data.table, example(data.table) and browseVignettes("data.table")
  Release notes, videos and slides: http://r-datatable.com

Attaching package: <U+393C><U+3E31>data.table<U+393C><U+3E32>

The following objects are masked from <U+393C><U+3E31>package:dplyr<U+393C><U+3E32>:

    between, first, last

The following object is masked from <U+393C><U+3E31>package:purrr<U+393C><U+3E32>:

    transpose

tidy_df <- as.data.table(tidy_df)
tidy_df <- tidy_df[is.na(as.numeric(word))]
tidy_df <- tidy_df[word != 'simpson']

Term frequency

Con nuestro data set limpio podemos representar en un gráfico de barras la frecuencia de términos. Lo que haremos será:

• agrupar por temporada
• sumar el número de veces que aparece el término (count)
• tomar el top 10 por temporada
• representar en un barplot para cada temporada dicha frecuencia

library(ggplot2)
tidy_df %>% group_by(season) %>%
        count(word, sort = FALSE) %>%
        top_n(15) %>%
        ggplot(aes(reorder(word,n), n, fill = season)) +
        geom_col() +
        coord_flip() +
        facet_wrap(~season, scales = "free_y") +
        labs(x = NULL) +
        guides(fill = FALSE) +
        scale_fill_brewer(palette = "Set1")

Selecting by n

Ahora que disponemos de la frecuencia podemos analizar la evolución en sus apariciones / tramas de cada personaje: + calculamos la frecuencia para todos los términos, no solo el top 15 + creamos dos listas, la familia Simpson y otros personajes relevantes de la trama + representamos ambas series series temporales

#install.packages('plotly')
require(plotly)
tidy_tf <- tidy_df %>% group_by(season) %>%
        count(word, sort = TRUE)
tidy_tf <- as.data.table(tidy_tf)
simpson_family <- c('homer', 'bart', 'lisa', 'maggie', 'marge', 'patty','selma')
other_characters <-  c('moe', 'ned', 'barney', 'modd', 'itchy', 'scratchy', 'krusty', 'burns', 'lenny', 'carl', 'edna', 'nelson', 'apu', 'milhouse', 'ralph', 'skinner', 'bob')
myplot <- ggplot(tidy_tf[tidy_tf$word %in% simpson_family], aes(x=season, y=n, group=word)) +
  geom_line(aes(color=word), size=1.25)+
  geom_point(aes(color=word))
ggplotly(myplot)

myplot <- ggplot(tidy_tf[tidy_tf$word %in% other_characters], aes(x=season, y=n, group=word)) +
  geom_line(aes(color=word), size=0.75)+
  geom_point(aes(color=word))
ggplotly(myplot)

Bigramas

También podemos obtener y representar los bigramas (conjunto de 2 términos) y sus frecuencias. Se representan en forma de grafo los más comunes (aquellos que aparecen al menos 7 veces en una misma temporada)

library(tidyr)
library(igraph)
library(tidytext)
bigram_graph <- df %>%
  unnest_tokens(bigram, Text, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  filter(!word1 %in% stop_words$word) %>%
  filter(!word2 %in% stop_words$word) %>% 
  group_by(season) %>%
  count(word1, word2, sort = TRUE) %>%
  select(word1, word2, season, n) %>%
  filter(n > 7) %>%
  graph_from_data_frame()
# str(bigram_graph)

library(ggraph)
set.seed(2017)
ggraph(bigram_graph, layout = "fr") +
  geom_edge_link() +
  geom_node_point() +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1)

a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
ggraph(bigram_graph, layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()

También podemos realizar tf_idf sobre nuestro corpus para localizar las palabras más relevantes, en general y por temporada

library(dplyr)
tf_idf_df <- tidy_df %>% 
        count(season, word, sort = TRUE) %>%
        bind_tf_idf(word, season, n)
tf_idf_df <- tf_idf_df[order(-tf_idf_df$tf_idf),] 

tf_idf_df %>% 
  top_n(20) %>%
  ggplot(aes(word, tf_idf, fill = season)) +
  geom_col() +
  labs(x = NULL, y = "tf-idf") +
  coord_flip()

Selecting by tf_idf

tf_idf_df %>% 
  group_by(season) %>% 
  top_n(8) %>% 
  ungroup %>%
  ggplot(aes(reorder(word, tf_idf), tf_idf, fill = season)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~season, ncol = 2, scales = "free") +
  coord_flip()

Selecting by tf_idf

Análisis de sentimiento

Valorar como positivo o negativo un mensaje es una tarea compleja, que requiere no sólo conocer el significado de las palabras sino también contextualizarlas, conocer la entonación en que se produce el mensaje, etc.

En este caso vamos a realizar una aproximación mucho más simple, que es la de considerar el texto como la combinación de palabras individuales y el sentimiento como la suma del sentimiento asociado a cada una de las palabras. Para ello tidytextnos ofrece tres posibles datasets (lexicon) de sentimientos: + AFINN from Finn Årup Nielsen (-5, 5), + bing from Bing Liu and collaborators(“positive” / “negative”) + nrc from Saif Mohammad and Peter Turney (“yes” / “no”).

Todos ellos basados en unigramas.

head(get_sentiments("afinn"), 3)

head(get_sentiments("bing"), 3)

head(get_sentiments("nrc"), 3)

tidy_df[, season_episode := paste0('S', season_num,"XE", str_pad(episode_num,width = 2,pad = "0"))]

library(tidyr)
simpson_sentiment <- tidy_df %>%
  inner_join(get_sentiments("bing")) %>%
  count(season_episode, sentiment) %>%
  spread(sentiment, n, fill = 0) %>%
  mutate(sentiment = positive - negative)

Joining, by = "word"

head(simpson_sentiment,3)

simpson_sentiment <- as.data.table(simpson_sentiment)
simpson_sentiment[, season:= str_sub(season_episode,start = 1, end = 2)]
simpson_sentiment[, season:= str_replace(season, "S", "Season ")]
simpson_sentiment[, episode:= str_sub(season_episode,start = 4, end = 6)]
ggplot(simpson_sentiment, aes(episode, sentiment, fill = season)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~season, ncol = 2, scales = "free_x")

afinn <- tidy_df %>% 
  inner_join(get_sentiments("afinn")) %>% 
  group_by(season_episode) %>% 
  summarise(sentiment = sum(score)) %>% 
  mutate(method = "AFINN")

Joining, by = "word"

afinn <- as.data.table(afinn)
afinn[, season:= str_sub(season_episode,start = 1, end = 2)]
afinn[, season:= str_replace(season, "S", "Season ")]
afinn[, episode:= str_sub(season_episode,start = 4, end = 6)]
ggplot(afinn, aes(episode, sentiment, fill = season)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~season, ncol = 2, scales = "free_x")

resplandior <- tidy_df[season_num==6 & episode_num==6]
afinn_r <- resplandior %>% 
  inner_join(get_sentiments("afinn")) %>% 
  group_by(season_episode) %>% 
  summarise(sentiment = sum(score)) %>% 
  mutate(method = "AFINN") %>% data.table()

Joining, by = "word"

bing_and_nrc_r <- bind_rows(resplandior %>% 
                            inner_join(get_sentiments("bing")) %>%
                            mutate(method = "Bing et al."),
                          resplandior %>% 
                            inner_join(get_sentiments("nrc") %>% 
                                         filter(sentiment %in% c("positive", 
                                                                 "negative"))) %>%
                            mutate(method = "NRC")) %>%
  count(method,  sentiment) %>%
  spread(sentiment, n, fill = 0) %>%
  mutate(sentiment = positive - negative)  %>% data.table()

Joining, by = "word"
Joining, by = "word"

comparativa <- rbind(afinn_r[, c("sentiment", "method"), with = F], bing_and_nrc_r[, c("sentiment", "method"), with = F])
ggplot(data=comparativa, aes(x=method, y=sentiment)) +
  geom_bar(stat="identity",fill="steelblue")+
  theme_minimal()

Anexos y otra información útil

• Tidy text: http://tidytextmining.com
• Stringr and Regex: https://rstudio-pubs-static.s3.amazonaws.com/180610_d3764c43f1e54692b7e84d21ec94772a.html
• Analisis Rick&Morty: http://tamaszilagyi.com/blog/a-tidy-text-analysis-of-rick-and-morty/
• Ggplot cheatsheet: https://www.rstudio.com/wp-content/uploads/2015/03/ggplot2-cheatsheet.pdf
• Plotly cheatsheet: https://images.plot.ly/plotly-documentation/images/r_cheat_sheet.pdf
• Curso text mining Data camp: https://www.datacamp.com/courses/intro-to-text-mining-bag-of-words
• Subtools: http://www.pieceofk.fr/?p=437

Si estás leyendo esto en diferido y tienes preguntas no dudes en localizarnos en Twitter